home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BLTQ12.ZIP / BB_CAI10.BAS < prev    next >
BASIC Source File  |  1993-01-04  |  12KB  |  440 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_cai10.bas 31-May-92 chh
  6. '--example using 8-char key, dups and
  7. '--a second index of LONG INT (on SSN field), dups allowed for this example
  8.  
  9. 'this code is for a simplistic database
  10. 'it uses a single DBF (true DBF-compat) and two related indexes
  11. 'the first index is on the first 5 chars of last name + first char first name
  12. 'second index is on the SSN, since it's a valid LONG INT we use that key type
  13.  
  14. 'C>bc bb_cai10 /o;
  15. 'C>link bb_cai10,,nul,bullet;
  16.  
  17. UseDir$ = ".\"                  'all files use this directory except
  18.                                 'the reindex work file which uses the
  19.                                 'SET TMP= directory or the current directory
  20. CLS
  21. PRINT "BB_CAI10.BAS - 8-CHAR (DUPS) and LONG INT (DUPS), add/reindex example"
  22. PRINT "--maintains *2* index files automatically, using NLS sorting."
  23. PRINT ">> USING DIRECTORY "; UseDir$
  24. PRINT
  25.  
  26. TYPE TestRecTYPE
  27. Tag AS STRING * 1
  28. FirstName AS STRING * 15        'a DBF C fieldtype
  29. LastName AS STRING * 19         'C
  30. SSN AS STRING * 9               'N (use C instead to use SUBSTR() on it)
  31. BDate AS STRING * 8             'D
  32. DeptNo AS STRING * 3            'C
  33. Salary AS STRING * 9            'N
  34. END TYPE '64                    'DBF III+ limit is 4000 bytes/128 fields
  35.                                 
  36. DIM DFP AS DOSFilePack
  37. DIM MP AS MemoryPack
  38. DIM IP AS InitPack
  39. DIM EP AS ExitPack
  40. DIM CDP AS CreateDataPack
  41. DIM CKP AS CreateKeyPack
  42. DIM OP AS OpenPack
  43. DIM AP(1 TO 2) AS AccessPack    '2 since we're maintaining 2 index files
  44.  
  45. DIM FieldList(1 TO 6) AS FieldDescTYPE
  46. DIM TestRec AS TestRecTYPE
  47. DIM ZSTR AS STRING * 1
  48. DIM NameDAT AS STRING * 80      'DBF data file
  49. DIM NameIX1 AS STRING * 80      'first index file
  50. DIM NameIX2 AS STRING * 80      'second index file
  51. DIM KX1 AS STRING * 136         'key expression for first index file
  52. DIM KX2 AS STRING * 136         'key expression for second index file
  53. DIM KeyBuffer AS STRING * 64
  54.  
  55. DIM First$(1 TO 26)
  56. DIM Last$(1 TO 26)
  57. GOSUB FillNamesIn
  58.  
  59. ZSTR = CHR$(0)
  60. NameDAT = UseDir$ + "CHARTEST.DBF" + ZSTR
  61. NameIX1 = UseDir$ + "CHARTEST.IX1" + ZSTR
  62. NameIX2 = UseDir$ + "CHARTEST.IX2" + ZSTR
  63.  
  64. FieldList(1).FieldName = "FIRSTNAME" + ZSTR
  65. FieldList(1).FieldType = "C"
  66. FieldList(1).FieldLength = CHR$(15)
  67. FieldList(1).FieldDC = CHR$(0)
  68. FieldList(2).FieldName = "LASTNAME" + ZSTR + ZSTR
  69. FieldList(2).FieldType = "C"
  70. FieldList(2).FieldLength = CHR$(19)
  71. FieldList(2).FieldDC = CHR$(0)
  72. FieldList(3).FieldName = "SSN" + STRING$(7, 0)
  73. FieldList(3).FieldType = "N"
  74. FieldList(3).FieldLength = CHR$(9)
  75. FieldList(3).FieldDC = CHR$(0)
  76. FieldList(4).FieldName = "BDATE" + STRING$(5, 0)
  77. FieldList(4).FieldType = "D"
  78. FieldList(4).FieldLength = CHR$(8)
  79. FieldList(4).FieldDC = CHR$(0)
  80. FieldList(5).FieldName = "DEPTNO" + STRING$(4, 0)
  81. FieldList(5).FieldType = "C"
  82. FieldList(5).FieldLength = CHR$(3)
  83. FieldList(5).FieldDC = CHR$(0)
  84. FieldList(6).FieldName = "SALARY" + STRING$(4, 0)
  85. FieldList(6).FieldType = "N"
  86. FieldList(6).FieldLength = CHR$(9)
  87. FieldList(6).FieldDC = CHR$(2)
  88.  
  89. level = 100
  90. MP.Func = MemoryXB
  91. stat = BULLET(MP)
  92. IF MP.Memory < 140000 THEN
  93.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  94.     MP.Func = MemoryXB
  95.     stat = BULLET(MP)
  96.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  97. END IF
  98.  
  99. level = 110
  100. IP.Func = InitXB
  101. IP.JFTmode = 0
  102. stat = BULLET(IP)
  103. IF stat THEN GOTO Abend
  104.  
  105. level = 120
  106. EP.Func = AtExitXB
  107. stat = BULLET(EP)
  108.  
  109. level = 130
  110. DFP.Func = DeleteFileDOS
  111. DFP.FilenamePtrOff = VARPTR(NameDAT)
  112. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  113. stat = BULLET(DFP)
  114. DFP.FilenamePtrOff = VARPTR(NameIX1)
  115. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  116. stat = BULLET(DFP)
  117. DFP.FilenamePtrOff = VARPTR(NameIX2)
  118. DFP.FilenamePtrSeg = VARSEG(NameIX2)
  119. stat = BULLET(DFP)
  120.  
  121. level = 1000
  122. CDP.Func = CreateDXB
  123. CDP.FilenamePtrOff = VARPTR(NameDAT)
  124. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  125. CDP.NoFields = 6
  126. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  127. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  128. CDP.FileID = 3
  129. stat = BULLET(CDP)
  130. IF stat THEN GOTO Abend
  131.  
  132. level = 1010
  133. OP.Func = OpenDXB
  134. OP.FilenamePtrOff = VARPTR(NameDAT)
  135. OP.FilenamePtrSeg = VARSEG(NameDAT)
  136. OP.ASmode = ReadWrite + DenyNone
  137. stat = BULLET(OP)
  138. IF stat THEN GOTO Abend
  139. HandDAT = OP.Handle
  140.  
  141. level = 1100
  142. KX1 = "SUBSTR(LASTNAME,1,5)+SUBSTR(FIRSTNAME,1,1)"
  143. CKP.Func = CreateKXB
  144. CKP.FilenamePtrOff = VARPTR(NameIX1)
  145. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  146. CKP.KeyExpPtrOff = VARPTR(KX1)
  147. CKP.KeyExpPtrSeg = VARSEG(KX1)
  148. CKP.XBlink = HandDAT
  149. CKP.KeyFlags = cCHAR
  150. CKP.CodePageID = -1
  151. CKP.CountryCode = -1
  152. CKP.CollatePtrOff = 0
  153. CKP.CollatePtrSeg = 0
  154. stat = BULLET(CKP)
  155. IF stat THEN GOTO Abend
  156.  
  157. level = 1102
  158. KX2 = "SSN"
  159. CKP.Func = CreateKXB
  160. CKP.FilenamePtrOff = VARPTR(NameIX2)
  161. CKP.FilenamePtrSeg = VARSEG(NameIX2)
  162. CKP.KeyExpPtrOff = VARPTR(KX2)
  163. CKP.KeyExpPtrSeg = VARSEG(KX2)
  164. CKP.XBlink = HandDAT
  165. CKP.KeyFlags = cLONG
  166. CKP.CodePageID = -1
  167. CKP.CountryCode = -1
  168. CKP.CollatePtrOff = 0
  169. CKP.CollatePtrSeg = 0
  170. stat = BULLET(CKP)
  171. IF stat THEN GOTO Abend
  172.  
  173. level = 1110
  174. OP.Func = OpenKXB
  175. OP.FilenamePtrOff = VARPTR(NameIX1)
  176. OP.FilenamePtrSeg = VARSEG(NameIX1)
  177. OP.ASmode = ReadWrite + DenyNone
  178. OP.xbHandle = HandDAT
  179. stat = BULLET(OP)
  180. IF stat THEN GOTO Abend
  181. HandIX1 = OP.Handle
  182.  
  183. level = 1112
  184. OP.Func = OpenKXB
  185. OP.FilenamePtrOff = VARPTR(NameIX2)
  186. OP.FilenamePtrSeg = VARSEG(NameIX2)
  187. OP.ASmode = ReadWrite + DenyNone
  188. OP.xbHandle = HandDAT
  189. stat = BULLET(OP)
  190. IF stat THEN GOTO Abend
  191. HandIX2 = OP.Handle
  192.  
  193. AP(1).Func = AddRecordXB
  194. AP(1).Handle = HandDAT
  195. AP(1).RecPtrOff = VARPTR(TestRec)
  196. AP(1).RecPtrSeg = VARSEG(TestRec)
  197. AP(1).KeyPtrOff = VARPTR(KeyBuffer)
  198. AP(1).KeyPtrSeg = VARSEG(KeyBuffer)
  199. AP(1).NextPtrOff = VARPTR(AP(2))
  200. AP(1).NextPtrSeg = VARSEG(AP(2))
  201. AP(2).Func = AddRecordXB
  202. AP(2).Handle = HandDAT
  203. AP(2).RecPtrOff = VARPTR(TestRec)
  204. AP(2).RecPtrSeg = VARSEG(TestRec)
  205. AP(2).KeyPtrOff = VARPTR(KeyBuffer)
  206. AP(2).KeyPtrSeg = VARSEG(KeyBuffer)
  207. AP(2).NextPtrOff = 0
  208. AP(2).NextPtrSeg = 0
  209.  
  210. level = 1200
  211. INPUT "Recs to add/reindex:"; Recs2Add&
  212. PRINT "Adding"; Recs2Add&; "records...";
  213.  
  214. 'these are not key values so just make them constant for this example
  215.  
  216. TestRec.Tag = " "
  217. TestRec.BDate = "19331122"   'yes, everyone is the same age
  218. TestRec.DeptNo = "001"       'yes, same dept too
  219. TestRec.Salary = "125000.77" 'and even the same salary
  220.  
  221. GOSUB StartTimer
  222. FOR recs& = 1 TO Recs2Add&
  223.    RandLN = 1 + (25 * RND)
  224.    RandFN = 1 + (25 * RND)
  225.    TestRec.FirstName = First$(RandLN)
  226.    TestRec.LastName = Last$(RandFN)
  227.    TestRec.SSN = LTRIM$(STR$(100000000 + (899999999 * RND)))
  228.    stat = BULLET(AP(1))
  229.    IF stat THEN GOTO Abend
  230. NEXT
  231. GOSUB EndTimer
  232. PRINT secs&; "secs."
  233.  
  234. level = 1210                            'could also reindex separately
  235. PRINT "Reindexing BOTH index files... ";
  236. AP(1).Func = ReindexXB
  237. AP(2).Func = ReindexXB
  238. AP(1).Handle = HandIX1
  239. AP(2).Handle = HandIX2
  240. GOSUB StartTimer
  241. sidx = BULLET(AP(1))
  242. IF sidx THEN stat = AP(sidx).stat
  243. IF stat THEN PRINT "on index"; sidx: GOTO Abend
  244. GOSUB EndTimer
  245. PRINT secs&; "secs."
  246.  
  247. level = 1300
  248. AP(1).Func = GetFirstXB
  249. stat = BULLET(AP(1))
  250. PRINT
  251. PRINT "Using key expression: "; RTRIM$(KX1)
  252. PRINT
  253. PRINT "...the first 5 keys/recs for first index file "
  254. CIX = 1: GOSUB DispRecord
  255. FOR i = 1 TO 4
  256.    IF stat THEN EXIT FOR
  257.    AP(1).Func = GetNextXB
  258.    stat = BULLET(AP(1))
  259.    GOSUB DispRecord
  260. NEXT
  261. IF stat = 202 THEN stat = 0
  262. IF stat THEN GOTO Abend
  263. PRINT
  264.  
  265. level = 1310
  266. AP(1).Func = GetLastXB
  267. stat = BULLET(AP(1))
  268. PRINT "...the last 5 keys/recs for first index file "
  269. CIX = 1: GOSUB DispRecord
  270. FOR i = 1 TO 4
  271.    IF stat THEN EXIT FOR
  272.    AP(1).Func = GetPrevXB
  273.    stat = BULLET(AP(1))
  274.    GOSUB DispRecord
  275. NEXT
  276. IF stat THEN GOTO Abend
  277. PRINT
  278. PRINT "* Press any key to see first/last 5 for SECOND index file";
  279. DO: LOOP UNTIL LEN(INKEY$)
  280. LOCATE , 1
  281.  
  282. level = 1302
  283. AP(2).Func = GetFirstXB
  284. stat = BULLET(AP(2))
  285. PRINT SPACE$(79);
  286. LOCATE , 1
  287. PRINT "Using key expression: "; RTRIM$(KX2)
  288. PRINT
  289. PRINT "...the first 5 keys/recs for second index file "
  290. CIX = 2: GOSUB DispRecord
  291. FOR i = 1 TO 4
  292.    IF stat THEN EXIT FOR
  293.